COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C ***** SUBROUTINES TO GO WITH S3X.F4 (RUNIT) *******
C00011 ENDMK
C⊗;
C ***** SUBROUTINES TO GO WITH S3X.F4 (RUNIT) *******
C* BGSORT,SQYY,ACCEL,PARAM  7/78

	SUBROUTINE BGSORT(BW)
C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
C  ALLOWS 100 BG TIMES.
	COMMON /Q/ BNW(200),NWZ
C****NEEDS TRAP FOR EXCEEDING 200 LIMIT ⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗
	DO 5308 K=1,NWZ
	X=BNW(K)-.0001
	Y=X+.0002
C   ROUND-OFF NONSENSE
	IF(BW.LE.X)GO TO 5308
 	IF(BW.LT.Y)RETURN
5308	CONTINUE
	NWZ=NWZ+1
	BNW(NWZ)=BW
	RETURN
	END

      SUBROUTINE SQYY(YY,X,Y,Z)
      YY=2.*Z/(X+Y)
      IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
      RETURN
      END

	FUNCTION RMOVX(W,Y,Z)
	IF(W.EQ.0)W=.01
	IF(Y.EQ.0)Y=.01
	RMOVX=Y*((W/Y)**Z)
	END

	SUBROUTINE ACCEL
	COMMON/P/P(1) /PL/PL(1)

	COMMON/VV/LIMIT,V(1)/A/NP(27),XT(27)
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,NONO,RD,IA
C  /C/=26
      IF(T5.EQ.1)GO TO 4020
	XA=RA
7020  RA=V(IA+K)
      IF(RA.EQ.-10000.)RETURN
4020  RD=1  
      IF(RA.LT.0)RD=-1. 
      RA=RA*RD    
      IF(KA.EQ.0)RA=RA-RC     
      W=RA  
      RB=W  
      IF(W.LE.Z-.0001)GO TO 2020    
C .0001 FOR ROUND-OFF ERRORS!!!!!!!
      IF(Z.NE.0)GO TO 3020    
      RA=RA/Y     
      RB=-1.
      RC=0  
      GO TO 8020  
3020      W=Z     
      RC=W+RC     
      GO TO 24    
2020      RC=0    
24	IF(X.NE.Y)GO TO 424
	RA=W/X
	GO TO 8020
C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
C   BG TIME OF NOTE. CHN=TBG.
424	RAX=XT(J)
	RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
	XT(J)=RAX+YY*RA
8020      IF(KA.EQ.0)RA=RA+XA 
      KA=1  
CXX   IF(RC.NE.0)GO TO 1011   
CCXX  IF(T5.EQ.1)RETURN
	IF(T5.NE.1)GO TO 1012
	IF(RC.NE.0)GO TO 2011
	RETURN
C  T5=1 IN 'RUNIT'
1012  V(IA+K)=RA*RD     
      IF(K.EQ.IZ)RETURN     
C*********** JUNE 1,71
1011      IF(T5.EQ.1)GO TO 2011     
      K=K+1 
      IF(ZZ.NE.0)Z=Z-W  
      IF(Z.GT.0)GO TO 7020
	IF(RB.EQ.-1.)GO TO 7020     
      IC=IC+1     
      IF(RB.EQ.W)RETURN
      KA=0  
      K=K-1 
      RETURN
2011      XA=RA   
	IF(K.GT.1)GO TO 9020
	K=I-6
      ZPAR=-9900.-CHN-ZZ
      DO 3011 KL=8,I     
      IF(V(K).NE.ZPAR)GO TO 3011
	IF(V(K+1).EQ.990000.)GO TO 9020    
3011      K=K-1
9020      W=ZZ  
	IF(V(K+3))K=K+3
C   ABOVE IS FOR TYPED IN TEMPO CHANGES
	KA=K+3
      ZZ=V(KA)
C   DUR OF NEXT TEMPI
	X=V(KA+1)
	Y=V(KA+2)
213      KA=0  
      Z=ZZ  
	CALL SQYY(YY,X,Y,Z)
      CHN=CHN+W   
	XT(J)=X
      IF(KA.EQ.1)Z=0    
      RA=PR 
	KA=0
	K=K+3
	GO TO 4020
	END

	SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
	COMMON/VV/LIMIT, V(1)
C  TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES:  -22=RHY  -33=NOTES  -44=NUMS  -46=RLIST  -36=RNOTES
C   -11=SUBN  -12=SUBR  -55=MOVE NUMS  -56=MOVE NOTES
C  -66=DUPL   -88=LIT  -57=MOVE RANGE NUMS  -58=MOVE RNG NOTES
	DO 1 K=1,LIMIT
	N=V(K)
	IF(N.LT.10000)GO TO 1
	IF(N/10000.NE.INUM)GO TO 1
	IF(MOD(N,10000).NE.IPAR)GO TO 1
	ISTRT=K+4
	KODE=V(K+2)
	ICNT=V(K+3)
	IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
	RETURN
C  FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1	CONTINUE
	END

	SUBROUTINE SHORT(KNP,K)
	COMMON /BLA/IBLA
C  DON'T TYPE TRAILING BLANKS
	DIMENSION KNP(1)
	DO 1 K=15,1,-1
1	IF(KNP(K).NE.IBLA)RETURN
	K=1
	END

	FUNCTION ALL(JPT,IPTX)
	COMMON /VV/LIMIT,V(1)
	DIMENSION JPT(1)
	K=IPTX-1
	IF(K.GT.0)GO TO 2
1    	K=JPT(-K)
	IF(K)GO TO 1
C  FOR 'ALL' WITH RR,RD,DF.  FOLLOWS UP ON POINTERS TO POINTERS!
	K=K-1
2	ALL=PARAM(V(K+3),K)
	END

C***** THIS IS NOW A 'FAIL' ROUTINE IN SPRINT.FAI
	FUNCTION PARAM(X,K)
	COMMON J,L  /P/P(1) /PL/PL(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,
	1 T2,T4,BY,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2
	K=0
C IF K IS NOT ZERO UPON RETURN, THEN WE'VE FOUND INFO IN OTHER PARAM.
	PARAM=X
	IF(X.GT.-9999.0)RETURN
	IF(X.EQ.-10000.0)RETURN
	K=-(X+9999.0)*100.+.1	
	PARAM=P(K)
C GET DATA FROM PARAM K
	PM=PL(K)
	IF(L.NE.2)RETURN
C L=CALLING PARAM NUM., K=PARAM REFERRED TO.
	IF(K.EQ.2)PARAM=PX2
C MUST USE 'UNPROCESSED' FORM OF P2 (I.E. NO 'TEMPO' CHANGES)
	END
	
C***** MICROTONES ********
	SUBROUTINE MICRO
	COMMON INUM,IPAR  /P/P(1) /PL/PL(1) 
C   CALL SUBROUTINE FROM ANY PARAMETER WHERE THE CALLING PARAMETER
C   AND THE IMMEDITELY PRECEDING PARAMETER ARE UNUSED BY YOUR INSTR.
C   P3 CAN BE NOTES OR NUMBS.

	X=P(3)
	IF(PL(3).EQ.1)GO TO 1
CC	X=IFIX(X)
C  FOR RAND NOTES TO LOCK ON NOTE NUMBERS.
CC	X=30.8677*2**(X/12)
	X=15.43385*2**(X/12)
C  X=FREQ. IN HZ. BASED ON NT # IN P3.  NUM. ABOVE IS B, IE. LOWEST B -1 OCT.
	PL(3)=1.
C  THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.

1	Y=IFIX(P(IPAR-1))
	Z=IFIX(P(IPAR))
C FIX NEEDED BECAUSE OF POSSIBLE NON-INTEGERS HERE.
	P(3)=X*2**(Y/Z)
C  IPAR (Z) IS THE CALLING PARAMETER.  IPAR-1 (Y) THE PREVIOUS PARAM.
C  X HAS BASE FREQ.
C  THE NUMBER IN P(IPAR)=# OF DIVISIONS OF THE OCTAVE.  
C  THE NUMBER IN P(IPAR-1)=CHROMATIC STEP IN THAT DIV.
	END